home *** CD-ROM | disk | FTP | other *** search
/ Internet Tools (InfoMagic) / Internet Tools.iso / archival / mirror / experimental / ftp.pl.Z / ftp.pl
Perl Script  |  1994-11-24  |  25KB  |  1,272 lines
  1. #-*-perl-*-
  2. # This is a wrapper to the lchat.pl routines that make life easier
  3. # to do ftp type work.
  4. # Mostly by Lee McLoughlin <lmjm@doc.ic.ac.uk>
  5. # based on original version by Alan R. Martello <al@ee.pitt.edu>
  6. # And by A.Macpherson@bnr.co.uk for multi-homed hosts
  7. #
  8. # Basic usage:
  9. #  $ftp_port = 21;
  10. #  $retry_call = 1;
  11. #  $attempts = 2;
  12. #  if( &ftp'open( $site, $ftp_port, $retry_call, $attempts ) != 1 ){
  13. #   die "failed to open ftp connection";
  14. #  }
  15. #  if( ! &ftp'login( $user, $pass ) ){
  16. #   die "failed to login";
  17. #  }
  18. #  &ftp'type( $text_mode ? 'A' : 'I' );
  19. #  if( ! &ftp'get( $remote_filename, $local_filename, 0 ) ){
  20. #   die "failed to get file;
  21. #  }
  22. #  &ftp'quit();
  23. #
  24. #
  25. # $Id: ftp.pl,v 2.6 1994/06/06 18:37:37 lmjm Exp lmjm $
  26. # $Log: ftp.pl,v $
  27. # Revision 2.6  1994/06/06  18:37:37  lmjm
  28. # Switched to lchat - a subset of chat.
  29. # Allow for 'remote help's need to parse the help strings in the continuations
  30. # Use real_site for proxy connections.
  31. # Allow for cr stripping and corrected use of buffer (from Andrew).
  32. #
  33. # Revision 2.5  1994/04/29  20:11:04  lmjm
  34. # Converted to use rfc1123.
  35. #
  36. # Revision 2.4  1994/01/26  14:59:07  lmjm
  37. # Added DG result code.
  38. #
  39. # Revision 2.3  1994/01/18  21:58:18  lmjm
  40. # Reduce calls to sigset.
  41. # Reset to old signal after use.
  42. #
  43. # Revision 2.2  1993/12/14  11:09:06  lmjm
  44. # Use installed socket.ph.
  45. # Allow for more returns.
  46. #
  47. # Revision 2.1  1993/06/28  15:02:00  lmjm
  48. # Full 2.1 release
  49. #
  50. #
  51.  
  52. require 'sys/socket.ph';
  53. # lchat.pl is a special subset of chat2.pl that avoids some memory leaks.
  54. require 'lchat.pl';
  55.  
  56.  
  57. package ftp;
  58.  
  59. $retry_pause = 60;    # Pause before retrying a login.
  60.  
  61. if( defined( &main'PF_INET ) ){
  62.     $pf_inet = &main'PF_INET;
  63.     $sock_stream = &main'SOCK_STREAM;
  64.     local($name, $aliases, $proto) = getprotobyname( 'tcp' );
  65.     $tcp_proto = $proto;
  66. }
  67. else {
  68.     # XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
  69.     # but who the heck would change these anyway? (:-)
  70.     $pf_inet = 2;
  71.     $sock_stream = 1;
  72.     $tcp_proto = 6;
  73. }
  74.  
  75. # If the remote ftp daemon doesn't respond within this time presume its dead
  76. # or something.
  77. $timeout = 120;
  78.  
  79. # Timeout a read if I don't get data back within this many seconds
  80. $timeout_read = 3 * $timeout;
  81.  
  82. # Timeout an open
  83. $timeout_open = $timeout;
  84.  
  85. $ftp'version = '$Revision: 2.6 $';
  86.  
  87. # This is a "global" it contains the last response from the remote ftp server
  88. # for use in error messages
  89. $ftp'response = "";
  90. # Also ftp'NS is the socket containing the data coming in from the remote ls
  91. # command.
  92.  
  93. # The size of block to be read or written when talking to the remote
  94. # ftp server
  95. $ftp'ftpbufsize = 4096;
  96.  
  97. # How often to print a hash out, when debugging
  98. $ftp'hashevery = 1024;
  99. # Output a newline after this many hashes to prevent outputing very long lines
  100. $ftp'hashnl = 70;
  101.  
  102. # Is there a connection open?
  103. $ftp'service_open = 0;
  104.  
  105. # If a proxy connection then who am I really talking to?
  106. $real_site = "";
  107.  
  108. # Where error/log reports are sent to
  109. $ftp'showfd = 'STDERR';
  110.  
  111. # Should a 421 be treated as a connection close and return 99 from
  112. # ftp'expect.  This is against rfc1123 recommendations but I've found
  113. # it to be a wise default.
  114. $drop_on_421 = 1;
  115.  
  116. # Name of a function to call on a pathname to map it into a remote
  117. # pathname.
  118. $ftp'mapunixout = '';
  119. $ftp'manunixin = '';
  120.  
  121. # This is just a tracing aid.
  122. $ftp_show = 0;
  123.  
  124. # Wether to keep the continuation messages so the user can look at them
  125. $ftp'keep_continuations = 0;
  126.  
  127. # Uncomment to turn on lots of debugging.
  128. # &ftp'debug( 10 );
  129.  
  130. sub ftp'debug
  131. {
  132.     $ftp_show = @_[0];
  133.     if( $ftp_show > 9 ){
  134.         $chat'debug = 1;
  135.     }
  136. }
  137.  
  138. sub ftp'set_timeout
  139. {
  140.     local( $to ) = @_;
  141.     return if $to == $timeout;
  142.     $timeout = $to;
  143.     $timeout_open = $timeout;
  144.     $timeout_read = 3 * $timeout;
  145.     if( $ftp_show ){
  146.         print $ftp'showfd "ftp timeout set to $timeout\n";
  147.     }
  148. }
  149.  
  150.  
  151. sub ftp'open_alarm
  152. {
  153.     die "timeout: open";
  154. }
  155.  
  156. sub ftp'timed_open
  157. {
  158.     local( $site, $ftp_port, $retry_call, $attempts ) = @_;
  159.     local( $connect_site, $connect_port );
  160.     local( $ret );
  161.  
  162.     alarm( $timeout_open );
  163.  
  164.     while( $attempts-- ){
  165.         if( $ftp_show ){
  166.             print $ftp'showfd "proxy connecting via $proxy_gateway [$proxy_ftp_port]\n" if $proxy;
  167.             print $ftp'showfd "Connecting to $site";
  168.             if( $ftp_port != 21 ){
  169.                 print $ftp'showfd " [port $ftp_port]";
  170.             }
  171.             print $ftp'showfd "\n";
  172.         }
  173.         
  174.         if( $proxy ) {
  175.             if( ! $proxy_gateway ) {
  176.                 # if not otherwise set
  177.                 $proxy_gateway = "internet-gateway";
  178.             }
  179.             if( $debug ) {
  180.                 print $ftp'showfd "using proxy services of $proxy_gateway, ";
  181.                 print $ftp'showfd "at $proxy_ftp_port\n";
  182.             }
  183.             $connect_site = $proxy_gateway;
  184.             $connect_port = $proxy_ftp_port;
  185.             $real_site = $site;
  186.         }
  187.         else {
  188.             $connect_site = $site;
  189.             $connect_port = $ftp_port;
  190.         }
  191.         if( ! &chat'open_port( $connect_site, $connect_port ) ){
  192.             if( $retry_call ){
  193.                 print $ftp'showfd "Failed to connect\n" if $ftp_show;
  194.                 next;
  195.             }
  196.             else {
  197.                 print $ftp'showfd "proxy connection failed " if $proxy;
  198.                 print $ftp'showfd "Cannot open ftp to $connect_site\n" if $ftp_show;
  199.                 return 0;
  200.             }
  201.         }
  202.         $ret = &ftp'expect( $timeout,
  203.             2, 1 ); # ready for login to $site
  204.         if( $ret != 1 ){
  205.             &chat'close();
  206.             next;
  207.         }
  208.         return 1;
  209.     }
  210.     continue {
  211.         print $ftp'showfd "Pausing between retries\n";
  212.         sleep( $retry_pause );
  213.     }
  214.     return 0;
  215. }
  216.  
  217. sub main'ftp__sighandler
  218. {
  219.     local( $sig ) = @_;
  220.     local( $msg ) = "Caught a SIG$sig flagging connection down";
  221.     $ftp'service_open = 0;
  222.     if( $ftp_logger ){
  223.         eval "&$ftp_logger( \$msg )";
  224.     }
  225. }
  226.  
  227. sub ftp'set_signals
  228. {
  229.     $ftp_logger = @_;
  230.     $SIG{ 'PIPE' } = "ftp__sighandler";
  231. }
  232.  
  233. # Set the mapunixout and mapunixin functions
  234. sub ftp'set_namemap
  235. {
  236.     ($ftp'mapunixout, $ftp'mapunixin) = @_;
  237.     if( $debug ) {
  238.         print $ftp'showfd "mapunixout = $ftp'mapunixout, $mapunixin = $ftp'mapunixin\n";
  239.     }
  240. }
  241.  
  242.  
  243. sub ftp'open
  244. {
  245.     local( $site, $ftp_port, $retry_call, $attempts ) = @_;
  246.  
  247.     local( $old_sig ) = $SIG{ 'ALRM' };
  248.     $SIG{ 'ALRM' } = "ftp\'open_alarm";
  249.  
  250.     local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
  251.     alarm( 0 );
  252.     $SIG{ 'ALRM' } = $old_sig;
  253.  
  254.     if( $@ =~ /^timeout/ ){
  255.         return -1;
  256.     }
  257.  
  258.     if( $ret ){
  259.         $ftp'service_open = 1;
  260.     }
  261.  
  262.     return $ret;
  263. }
  264.  
  265. sub ftp'login
  266. {
  267.     local( $remote_user, $remote_password ) = @_;
  268.         local( $ret );
  269.  
  270.     if( ! $ftp'service_open ){
  271.         return 0;
  272.     }
  273.  
  274.     if( $proxy ){
  275.         # Should site or real_site be used here?
  276.         &ftp'send( "USER $remote_user@$real_site" );
  277.     }
  278.     else {
  279.         &ftp'send( "USER $remote_user" );
  280.     }
  281.     $ret = &ftp'expect( $timeout,
  282.         2, 1,   # $remote_user logged in
  283.         331, 2,   # send password for $remote_user
  284.         332, 0 ); # account for login - not yet supported
  285.     if( $ret == 99 ){
  286.         &service_closed();
  287.         $ret = 0;
  288.     }
  289.     if( $ret == 1 ){
  290.         # Logged in no password needed
  291.         return 1;
  292.     }
  293.     elsif( $ret == 2 ){
  294.         # A password is needed
  295.         &ftp'send( "PASS $remote_password" );
  296.  
  297.         $ret = &ftp'expect( $timeout,
  298.             2, 1 ); # $remote_user logged in
  299.         if( $ret == 99 ){
  300.             &service_closed();
  301.         }
  302.         elsif( $ret == 1 ){
  303.             # Logged in
  304.             return 1;
  305.         }
  306.     }
  307.     # If I got here I failed to login
  308.     return 0;
  309. }
  310.  
  311. sub service_closed
  312. {
  313.     $ftp'service_open = 0;
  314.     &chat'close();
  315. }
  316.  
  317. sub ftp'close
  318. {
  319.     &ftp'quit();
  320.     $ftp'service_open = 0;
  321.     &chat'close();
  322. }
  323.  
  324. # Change directory
  325. # return 1 if successful
  326. # 0 on a failure
  327. sub ftp'cwd
  328. {
  329.     local( $dir ) = @_;
  330.     local( $ret );
  331.  
  332.     if( ! $ftp'service_open ){
  333.         return 0;
  334.     }
  335.  
  336.     if( $ftp'mapunixout ){
  337.         $dir = eval "&$ftp'mapunixout( \$dir, 'd' )";
  338.     }
  339.  
  340.     &ftp'send( "CWD $dir" );
  341.  
  342.     $ret = &ftp'expect( $timeout,
  343.         2, 1 ); # working directory = $dir
  344.     if( $ret == 99 ){
  345.         &service_closed();
  346.         $ret = 0;
  347.     }
  348.  
  349.     return $ret;
  350. }
  351.  
  352. # Get a full directory listing:
  353. # &ftp'dir( remote LIST options )
  354. # Start a list going with the given options.
  355. # Presuming that the remote deamon uses the ls command to generate the
  356. # data to send back then then you can send it some extra options (eg: -lRa)
  357. # return 1 if sucessful and 0 on a failure
  358. sub ftp'dir_open
  359. {
  360.     local( $options ) = @_;
  361.     local( $ret );
  362.     
  363.     if( ! $ftp'service_open ){
  364.         return 0;
  365.     }
  366.  
  367.     if( ! &ftp'open_data_socket() ){
  368.         return 0;
  369.     }
  370.     
  371.     if( $options ){
  372.         &ftp'send( "LIST $options" );
  373.     }
  374.     else {
  375.         &ftp'send( "LIST" );
  376.     }
  377.     
  378.     $ret = &ftp'expect( $timeout,
  379.         1, 1 ); # reading directory
  380.     if( $ret == 99 ){
  381.         &service_closed();
  382.         $ret = 0;
  383.     }
  384.  
  385.     if( ! $ret ){
  386.         &ftp'close_data_socket;
  387.         return 0;
  388.     }
  389.     
  390.     accept( NS, S ) || die "accept failed $!";
  391.  
  392.     # 
  393.     # the data should be coming at us now
  394.     #
  395.     
  396.     return 1;
  397. }
  398.  
  399.  
  400. # Close down reading the result of a remote ls command
  401. # return 1 if successful and 0 on failure
  402. sub ftp'dir_close
  403. {
  404.     local( $ret );
  405.  
  406.     if( ! $ftp'service_open ){
  407.         return 0;
  408.     }
  409.  
  410.     # read the close
  411.     #
  412.     $ret = &ftp'expect($timeout,
  413.             2, 1 ); # transfer complete, closing connection
  414.     if( $ret == 99 ){
  415.         &service_closed();
  416.         $ret = 0;
  417.     }
  418.  
  419.     # shut down our end of the socket
  420.     &ftp'close_data_socket;
  421.  
  422.     if( ! $ret ){
  423.         return 0;
  424.     }
  425.  
  426.     return 1;
  427. }
  428.  
  429. # Quit from the remote ftp server
  430. # return 1 if successful and 0 on failure
  431. sub ftp'quit
  432. {
  433.     local( $ret );
  434.  
  435.     $site_command_check = 0;
  436.     @site_command_list = ();
  437.  
  438.     if( ! $ftp'service_open ){
  439.         return 0;
  440.     }
  441.  
  442.     &ftp'send( "QUIT" );
  443.  
  444.     $ret = &ftp'expect( $timeout, 
  445.         2, 1 ); # transfer complete, closing connection
  446.     if( $ret == 99 ){
  447.         &service_closed();
  448.         $ret = 0;
  449.     }
  450.     return $ret;
  451. }
  452.  
  453. # Support for ftp'read
  454. sub ftp'read_alarm
  455. {
  456.     die "timeout: read";
  457. }
  458.  
  459. # Support for ftp'read
  460. sub ftp'timed_read
  461. {
  462.     alarm( $timeout_read );
  463.  
  464.     return sysread( NS, $ftpbuf, $ftpbufsize );
  465. }
  466.  
  467. # Do not use this routing use ftp'get
  468. sub ftp'read_nosel
  469. {
  470.     if( ! $ftp'service_open ){
  471.         return -1;
  472.     }
  473.  
  474.     local( $ret ) = eval '&timed_read()';
  475.     alarm( 0 );
  476.  
  477.     if( $@ =~ /^timeout/ ){
  478.         return -1;
  479.     }
  480.     return $ret;
  481. }
  482.  
  483. sub ftp'read
  484. {
  485.     if( ! $ftp'service_open ){
  486.         return -1;
  487.     }
  488.  
  489.     $nfound = select( $read_out = $read_in, undef, undef, $to = $timeout_read );
  490.  
  491.     if( $nfound <= 0 ){
  492.         return -1;
  493.     }
  494.     return sysread( NS, $ftpbuf, $ftpbufsize );
  495. }
  496.  
  497. sub ftp'dostrip
  498. {
  499.     ($strip_cr ) = @_;
  500. }
  501.  
  502. # Get a remote file back into a local file.
  503. # If no loc_fname passed then uses rem_fname.
  504. # returns 1 on success and 0 on failure
  505. sub ftp'get
  506. {
  507.     local($rem_fname, $loc_fname, $restart ) = @_;
  508.     local( $ret );
  509.     
  510.     if( ! $ftp'service_open ){
  511.         return 0;
  512.     }
  513.  
  514.     if( $loc_fname eq "" ){
  515.         $loc_fname = $rem_fname;
  516.     }
  517.     
  518.     if( ! &ftp'open_data_socket() ){
  519.         print $ftp'showfd "Cannot open data socket\n";
  520.         return 0;
  521.     }
  522.  
  523.     if( $loc_fname ne '-' ){
  524.         # Find the size of the target file
  525.         local( $restart_at ) = &ftp'filesize( $loc_fname );
  526.         if( $restart && $restart_at > 0 && &ftp'restart( $restart_at ) ){
  527.             $restart = 1;
  528.             # Make sure the file can be updated
  529.             chmod( 0644, $loc_fname );
  530.         }
  531.         else {
  532.             $restart = 0;
  533.             unlink( $loc_fname );
  534.         }
  535.     }
  536.  
  537.     if( $ftp'mapunixout ){
  538.         $rem_fname = eval "&$ftp'mapunixout( \$rem_fname, 'f' )";
  539.     }
  540.  
  541.     &ftp'send( "RETR $rem_fname" );
  542.     
  543.     $ret = &ftp'expect( $timeout, 
  544.         1, 1 ); # receiving $rem_fname
  545.     if( $ret == 99 ){
  546.         &service_closed();
  547.         $ret = 0;
  548.     }
  549.     if( $ret != 1 ){
  550.         print $ftp'showfd "Failure on 'RETR $rem_fname' command\n";
  551.  
  552.         # shut down our end of the socket
  553.         &ftp'close_data_socket;
  554.  
  555.         return 0;
  556.     }
  557.  
  558.     accept( NS, S ) || die "accept failed $!";
  559.  
  560.     # 
  561.     # the data should be coming at us now
  562.     #
  563.  
  564.     #
  565.     #  open the local fname
  566.     #  concatenate on the end if restarting, else just overwrite
  567.     if( !open( FH, ($restart ? '>>' : '>') . $loc_fname ) ){
  568.         print $ftp'showfd "Cannot create local file $loc_fname\n";
  569.  
  570.         # shut down our end of the socket
  571.         &ftp'close_data_socket;
  572.  
  573.         return 0;
  574.     }
  575.  
  576.     local( $start_time ) = time;
  577.     local( $bytes, $lasthash, $hashes ) = (0, 0, 0);
  578.  
  579. # Use these three lines if you do not have the select() SYSTEM CALL in
  580. # your perl.  There appears to be a memory leak in using these
  581. # and they are usually slower - so only use if you have to!
  582. #  Also comment back in the $SIG... line at the end of the while() loop.
  583. #    local( $old_sig ) = $SIG{ 'ALRM' };
  584. #    $SIG{ 'ALRM' } = "ftp\'read_alarm";
  585. #    while( ($len = &ftp'read_nosel()) > 0 ){
  586.  
  587. # If you have select() then use the following two lines.
  588.     vec( $read_in, fileno( NS ), 1 ) = 1;
  589.     while( ($len = &ftp'read()) > 0 ){
  590.  
  591.         $bytes += $len;
  592.         if( $strip_cr ){
  593.             $ftp'ftpbuf =~ s/\r//g;
  594.         }
  595.         if( $ftp_show ){
  596.             while( $bytes > ($lasthash + $ftp'hashevery) ){
  597.                 print $ftp'showfd '#';
  598.                 $lasthash += $ftp'hashevery;
  599.                 $hashes++;
  600.                 if( ($hashes % $ftp'hashnl) == 0 ){
  601.                     print $ftp'showfd "\n";
  602.                 }
  603.             }
  604.         }
  605.         if( ! print FH $ftp'ftpbuf ){
  606.             print $ftp'showfd "\nfailed to write data";
  607.             $bytes = -1;
  608.             last;
  609.         }
  610.     }
  611.  
  612. # Add the next line back if you don't have select().
  613. #    $SIG{ 'ALRM' } = $old_sig;
  614.  
  615.     close( FH );
  616.  
  617.     # shut down our end of the socket
  618.     &ftp'close_data_socket;
  619.  
  620.     if( $len < 0 ){
  621.         print $ftp'showfd "\ntimed out reading data!\n";
  622.  
  623.         return 0;
  624.     }
  625.         
  626.     if( $ftp_show && $bytes > 0 ){
  627.         if( $hashes && ($hashes % $ftp'hashnl) != 0 ){
  628.             print $ftp'showfd "\n";
  629.         }
  630.         local( $secs ) = (time - $start_time);
  631.         if( $secs <= 0 ){
  632.             $secs = 1; # To avoid a divide by zero;
  633.         }
  634.  
  635.         local( $rate ) = int( $bytes / $secs );
  636.         print $ftp'showfd "Got $bytes bytes ($rate bytes/sec)\n";
  637.     }
  638.  
  639.     #
  640.     # read the close
  641.     #
  642.  
  643.     $ret = &ftp'expect( $timeout, 
  644.         2, 1 ); # transfer complete, closing connection
  645.     if( $ret == 99 ){
  646.         &service_closed();
  647.         $ret = 0;
  648.     }
  649.  
  650.     if( $ret && $bytes < 0 ){
  651.         $ret = 0;
  652.     }
  653.  
  654.     return $ret;
  655. }
  656.  
  657. sub ftp'delete
  658. {
  659.     local( $rem_fname ) = @_;
  660.     local( $ret );
  661.  
  662.     if( ! $ftp'service_open ){
  663.         return 0;
  664.     }
  665.  
  666.     if( $ftp'mapunixout ){
  667.         $rem_fname = eval "&$ftp'mapunixout( \$rem_fname, 'f' )";
  668.     }
  669.  
  670.     &ftp'send( "DELE $rem_fname" );
  671.  
  672.     $ret = &ftp'expect( $timeout, 
  673.         2, 1 ); # Deleted $rem_fname
  674.     if( $ret == 99 ){
  675.         &service_closed();
  676.         $ret = 0;
  677.     }
  678.  
  679.     return $ret == 1;
  680. }
  681.  
  682. sub ftp'deldir
  683. {
  684.     local( $fname ) = @_;
  685.  
  686.     # not yet implemented
  687.     # RMD
  688. }
  689.  
  690. # UPDATE ME!!!!!!
  691. # Add in the hash printing and newline conversion
  692. sub ftp'put
  693. {
  694.     local( $loc_fname, $rem_fname ) = @_;
  695.     local( $strip_cr );
  696.     
  697.     if( ! $ftp'service_open ){
  698.         return 0;
  699.     }
  700.  
  701.     if( $loc_fname eq "" ){
  702.         $loc_fname = $rem_fname;
  703.     }
  704.     
  705.     if( ! &ftp'open_data_socket() ){
  706.         return 0;
  707.     }
  708.     
  709.     if( $ftp'mapunixout ){
  710.         $rem_fname = eval "&$ftp'mapunixout( \$rem_fname, 'f' )";
  711.     }
  712.  
  713.     &ftp'send( "STOR $rem_fname" );
  714.     
  715.     # 
  716.     # the data should be coming at us now
  717.     #
  718.     
  719.     local( $ret ) =
  720.     &ftp'expect( $timeout, 
  721.         1, 1 ); # sending $loc_fname
  722.     if( $ret == 99 ){
  723.         &service_closed();
  724.         $ret = 0;
  725.     }
  726.  
  727.     if( $ret != 1 ){
  728.         # shut down our end of the socket
  729.         &ftp'close_data_socket;
  730.  
  731.         return 0;
  732.     }
  733.  
  734.  
  735.     accept( NS, S ) || die "accept failed $!";
  736.  
  737.     # 
  738.     # the data should be coming at us now
  739.     #
  740.     
  741.     #
  742.     #  open the local fname
  743.     #
  744.     if( !open( FH, "<$loc_fname" ) ){
  745.         print $ftp'showfd "Cannot open local file $loc_fname\n";
  746.  
  747.         # shut down our end of the socket
  748.         &ftp'close_data_socket;
  749.  
  750.         return 0;
  751.     }
  752.     
  753.     while( <FH> ){
  754.         if( ! $ftp'service_open ){
  755.             last;
  756.         }
  757.         print NS ;
  758.     }
  759.     close( FH );
  760.     
  761.     # shut down our end of the socket to signal EOF
  762.     &ftp'close_data_socket;
  763.     
  764.     #
  765.     # read the close
  766.     #
  767.     
  768.     $ret = &ftp'expect( $timeout, 
  769.         2, 1 ); # transfer complete, closing connection
  770.     if( $ret == 99 ){
  771.         &service_closed();
  772.         $ret = 0;
  773.     }
  774.     if( ! $ret ){
  775.         print $ftp'showfd "Failure on 'STOR $loc_fname' command\n";
  776.     }
  777.     return $ret;
  778. }
  779.  
  780. sub ftp'restart
  781. {
  782.     local( $restart_point, $ret ) = @_;
  783.  
  784.     if( ! $ftp'service_open ){
  785.         return 0;
  786.     }
  787.  
  788.     &ftp'send( "REST $restart_point" );
  789.  
  790.     # 
  791.     # see what they say
  792.  
  793.     $ret = &ftp'expect( $timeout, 
  794.         3, 1 );   # restarting at $restart_point
  795.     if( $ret == 99 ){
  796.         &service_closed();
  797.         $ret = 0;
  798.     }
  799.     return $ret;
  800. }
  801.  
  802. # Set the file transfer type
  803. sub ftp'type
  804. {
  805.     local( $type ) = @_;
  806.  
  807.     if( ! $ftp'service_open ){
  808.         return 0;
  809.     }
  810.  
  811.     &ftp'send( "TYPE $type" );
  812.  
  813.     # 
  814.     # see what they say
  815.  
  816.     $ret = &ftp'expect( $timeout, 
  817.         2, 1 ); # file type set to $type
  818.     if( $ret == 99 ){
  819.         &service_closed();
  820.         $ret = 0;
  821.     }
  822.     return $ret;
  823. }
  824.  
  825. $site_command_check = 0;
  826. @site_command_list = ();
  827.  
  828. # routine to query the remote server for 'SITE' commands supported
  829. sub ftp'site_commands
  830. {
  831.     local( $ret );
  832.     
  833.     @site_command_list = ();
  834.     $site_command_check = 0;
  835.  
  836.     if( ! $ftp'service_open ){
  837.         return @site_command_list;
  838.     }
  839.  
  840.     # if we havent sent a 'HELP SITE', send it now
  841.     if( !$site_command_check ){
  842.     
  843.         $site_command_check = 1;
  844.     
  845.         &ftp'send( "HELP SITE" );
  846.     
  847.         # assume the line in the HELP SITE response with the 'HELP'
  848.         # command is the one for us
  849.         $ftp'keep_continuations = 1;
  850.         $ret = &ftp'expect( $timeout,
  851.             ".*HELP.*", 1 );
  852.         $ftp'keep_continuations = 0;
  853.         if( $ret == 99 ){
  854.             &service_closed();
  855.             return @site_command_list;
  856.         }
  857.     
  858.         if( $ret != 0 ){
  859.             print $ftp'showfd "No response from HELP SITE ($ret)\n" if( $ftp_show );
  860.         }
  861.     
  862.         @site_command_list = split(/\s+/, $ftp'response);
  863.     }
  864.     
  865.     return @site_command_list;
  866. }
  867.  
  868. # return the pwd, or null if we can't get the pwd
  869. sub ftp'pwd
  870. {
  871.     local( $ret, $cwd );
  872.  
  873.     if( ! $ftp'service_open ){
  874.         return 0;
  875.     }
  876.  
  877.     &ftp'send( "PWD" );
  878.  
  879.     # 
  880.     # see what they say
  881.  
  882.     $ret = &ftp'expect( $timeout, 
  883.         2, 1 ); # working dir is
  884.     if( $ret == 99 ){
  885.         &service_closed();
  886.         $ret = 0;
  887.     }
  888.     if( $ret ){
  889.         if( $ftp'response =~ /^2\d\d\s*"(.*)"\s.*$/ ){
  890.             $cwd = $1;
  891.         }
  892.     }
  893.     return $cwd;
  894. }
  895.  
  896. # return 1 for success, 0 for failure
  897. sub ftp'mkdir
  898. {
  899.     local( $path ) = @_;
  900.     local( $ret );
  901.  
  902.     if( ! $ftp'service_open ){
  903.         return 0;
  904.     }
  905.  
  906.     if( $ftp'mapunixout ){
  907.         $path = eval "&$ftp'mapunixout( \$path, 'f' )";
  908.     }
  909.  
  910.     &ftp'send( "MKD $path" );
  911.  
  912.     # 
  913.     # see what they say
  914.  
  915.     $ret = &ftp'expect( $timeout, 
  916.         2, 1 ); # made directory $path
  917.     if( $ret == 99 ){
  918.         &service_closed();
  919.         $ret = 0;
  920.     }
  921.     return $ret;
  922. }
  923.  
  924. # return 1 for success, 0 for failure
  925. sub ftp'chmod
  926. {
  927.     local( $path, $mode ) = @_;
  928.     local( $ret );
  929.  
  930.     if( ! $ftp'service_open ){
  931.         return 0;
  932.     }
  933.  
  934.     if( $ftp'mapunixout ){
  935.         $path = eval "&$ftp'mapunixout( \$path, 'f' )";
  936.     }
  937.  
  938.     &ftp'send( sprintf( "SITE CHMOD %o $path", $mode ) );
  939.  
  940.     # 
  941.     # see what they say
  942.  
  943.     $ret = &ftp'expect( $timeout, 
  944.         2, 1 ); # chmod $mode $path succeeded
  945.     if( $ret == 99 ){
  946.         &service_closed();
  947.         $ret = 0;
  948.     }
  949.     return $ret;
  950. }
  951.  
  952. # rename a file
  953. sub ftp'rename
  954. {
  955.     local( $old_name, $new_name ) = @_;
  956.     local( $ret );
  957.  
  958.     if( ! $ftp'service_open ){
  959.         return 0;
  960.     }
  961.  
  962.     if( $ftp'mapunixout ){
  963.         $old_name = eval "&$ftp'mapunixout( \$old_name, 'f' )";
  964.     }
  965.  
  966.     &ftp'send( "RNFR $old_name" );
  967.  
  968.     # 
  969.     # see what they say
  970.  
  971.     $ret = &ftp'expect( $timeout, 
  972.         3, 1 ); #  OK
  973.     if( $ret == 99 ){
  974.         &service_closed();
  975.         $ret = 0;
  976.     }
  977.  
  978.     # check if the "rename from" occurred ok
  979.     if( $ret ){
  980.         if( $ftp'mapunixout ){
  981.             $new_name = eval "&$ftp'mapunixout( \$new_name, 'f' )";
  982.         }
  983.  
  984.         &ftp'send( "RNTO $new_name" );
  985.     
  986.         # 
  987.         # see what they say
  988.     
  989.         $ret = &ftp'expect( $timeout, 
  990.             2, 1 );  # rename $old_name to $new_name
  991.         if( $ret == 99 ){
  992.             &service_closed();
  993.             $ret = 0;
  994.         }
  995.     }
  996.  
  997.     return $ret;
  998. }
  999.  
  1000.  
  1001. sub ftp'quote
  1002. {
  1003.     local( $cmd ) = @_;
  1004.     local( $ret );
  1005.  
  1006.     if( ! $ftp'service_open ){
  1007.         return 0;
  1008.     }
  1009.  
  1010.     &ftp'send( $cmd );
  1011.  
  1012.     $ret = &ftp'expect( $timeout, 
  1013.         2, 1 ); # Remote '$cmd' OK
  1014.     if( $ret == 99 ){
  1015.         &service_closed();
  1016.         $ret = 0;
  1017.     }
  1018.     return $ret;
  1019. }
  1020.  
  1021. # ------------------------------------------------------------------------------
  1022. # These are the lower level support routines
  1023.  
  1024. sub ftp'expectgot
  1025. {
  1026.     ($ftp'resp, $ftp'fatalerror) = @_;
  1027.     if( $ftp_show ){
  1028.         print $ftp'showfd "$ftp'resp\n";
  1029.     }
  1030.     if( $ftp'keep_continuations ){
  1031.         $ftp'response .= $ftp'resp;
  1032.     }
  1033.     else {
  1034.         $ftp'response = $ftp'resp;
  1035.     }
  1036. }
  1037.  
  1038. #
  1039. #  create the list of parameters for chat'expect
  1040. #
  1041. #  ftp'expect( time_out, {value, return value} );
  1042. #  the last response is stored in $ftp'response
  1043. #
  1044. sub ftp'expect
  1045. {
  1046.     local( $ret );
  1047.     local( $time_out );
  1048.     local( @expect_args );
  1049.     local( $code, $pre );
  1050.     
  1051.     $ftp'response = '';
  1052.     $ftp'fatalerror = 0;
  1053.  
  1054.     $time_out = shift( @_ );
  1055.     
  1056.     if( $drop_on_421 ){
  1057.         # Handle 421 specially - has to go first in case a pattern
  1058.         # matches on a generic 4.. response
  1059.         push( @expect_args, "[.|\n]*^(421 .*)\\015\\n" );
  1060.         push( @expect_args, "&expectgot( \$1, 0 ); 99" );
  1061.     }
  1062.  
  1063.     # Match any obvious continuations.
  1064.     push( @expect_args, "[.|\n]*^(\\d\\d\\d-.*|[^\\d].*)\\015\\n" );
  1065.     push( @expect_args, "&expectgot( \$1, 0 ); 100" );
  1066.  
  1067.     while( @_ ){
  1068.         $code = shift( @_ );
  1069.         $pre = '^';
  1070.         $post = ' ';
  1071.         if( $code =~ /^\d\d+$/ ){
  1072.             $pre = "[.|\n]*^";
  1073.         }
  1074.         elsif( $code =~ /^\d$/ ){
  1075.             $pre = "[.|\n]*^";
  1076.             $post = '\d\d ';
  1077.         }
  1078.         push( @expect_args, "$pre(" . $code . $post . ".*)\\015\\n" );
  1079.         push( @expect_args,
  1080.             "&expectgot( \$1, 0 ); " . shift( @_ ) );
  1081.     }
  1082.     # Match any numeric response codes not explicitly looked for.
  1083.     push( @expect_args, "[.|\n]*^(\\d\\d\\d .*)\\015\\n" );
  1084.     push( @expect_args, "&expectgot( \$1, 0 ); 0" );
  1085.     
  1086.     # Treat all unrecognised lines as continuations
  1087.     push( @expect_args, "^(.*)\\015\\n" );
  1088.     push( @expect_args, "&expectgot( \$1, 0 ); 100" );
  1089.     
  1090.     # add patterns TIMEOUT and EOF
  1091.     push( @expect_args, 'TIMEOUT' );
  1092.     push( @expect_args, "&expectgot( 'timed out', 0 ); 0" );
  1093.     push( @expect_args, 'EOF' );
  1094.     push( @expect_args, "&expectgot( 'remote server gone away', 1 ); 99" );
  1095.     
  1096.     # if we see a continuation line, wait for the real info
  1097.     $ret = 100;
  1098.     while( $ret == 100 ){
  1099.         if( $ftp_show > 9 ){
  1100.             &printargs( $time_out, @expect_args );
  1101.         }
  1102.         $ret = &chat'expect( $time_out, @expect_args );
  1103.     }
  1104.  
  1105.     return $ret;
  1106. }
  1107.  
  1108.  
  1109. #
  1110. #  opens NS for io
  1111. #
  1112. sub ftp'open_data_socket
  1113. {
  1114.     local( $sockaddr, $port );
  1115.     local( $type, $myaddr, $a, $b, $c, $d );
  1116.     local( $mysockaddr, $family, $hi, $lo );
  1117.     
  1118.     $sockaddr = 'S n a4 x8';
  1119.  
  1120.     ($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
  1121.     $this = $chat'thisproc;
  1122.     
  1123.     socket( S, $pf_inet, $sock_stream, $tcp_proto ) || die "socket: $!";
  1124.     bind( S, $this ) || die "bind: $!";
  1125.     
  1126.     # get the port number
  1127.     $mysockaddr = getsockname( S );
  1128.     ($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr );
  1129.     
  1130.     $hi = ($port >> 8) & 0x00ff;
  1131.     $lo = $port & 0x00ff;
  1132.     
  1133.     #
  1134.     # we MUST do a listen before sending the port otherwise
  1135.     # the PORT may fail
  1136.     #
  1137.     listen( S, 5 ) || die "listen";
  1138.     
  1139.     &ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" );
  1140.     
  1141.     return &ftp'expect( $timeout,
  1142.         2, 1 ); # PORT command successful
  1143. }
  1144.     
  1145. sub ftp'close_data_socket
  1146. {
  1147.     close( NS );
  1148. }
  1149.  
  1150. sub ftp'send
  1151. {
  1152.     local( $send_cmd ) = @_;
  1153.  
  1154.     if( $send_cmd =~ /\n/ ){
  1155.         print $ftp'showfd "ERROR, \\n in send string for $send_cmd\n";
  1156.     }
  1157.     
  1158.     if( $ftp_show ){
  1159.         local( $sc ) = $send_cmd;
  1160.  
  1161.         if( $send_cmd =~ /^PASS/){
  1162.             $sc = "PASS <somestring>";
  1163.         }
  1164.         print $ftp'showfd "---> $sc\n";
  1165.     }
  1166.     
  1167.     &chat'print( "$send_cmd\r\n" );
  1168. }
  1169.  
  1170. sub ftp'printargs
  1171. {
  1172.     while( @_ ){
  1173.         print $ftp'showfd shift( @_ ) . "\n";
  1174.     }
  1175. }
  1176.  
  1177. sub ftp'filesize
  1178. {
  1179.     local( $fname ) = @_;
  1180.  
  1181.     if( ! -f $fname ){
  1182.         return -1;
  1183.     }
  1184.  
  1185.     return (stat( _ ))[ 7 ];
  1186.     
  1187. }
  1188.  
  1189. # Reply codes, see RFC959:
  1190. # 1yz Positive Preliminary.  Expect another reply before proceeding
  1191. # 2yz Positive Completion.
  1192. # 3yz Positive Intermediate. More information required.
  1193. # 4yz Transient Negative Completion.  The user should try again.
  1194. # 5yz Permanent Negative Completion.
  1195. # x0z Syntax error
  1196. # x1z Information
  1197. # x2z Connection - control info.
  1198. # x3z Authentication and accounting.
  1199. # x4z Unspecified
  1200. # x5z File system.
  1201.  
  1202. # 110 Restart marker reply.
  1203. #     In this case, the text is exact and not left to the
  1204. #     particular implementation; it must read:
  1205. #     MARK yyyy = mmmm
  1206. #     Where yyyy is User-process data stream marker, and mmmm
  1207. #     server's equivalent marker (note the spaces between markers
  1208. #     and "=").
  1209. # 120 Service ready in nnn minutes.
  1210. # 125 Data connection already open; transfer starting.
  1211. # 150 File status okay; about to open data connection.
  1212.  
  1213. # 200 Command okay.
  1214. # 202 Command not implemented, superfluous at this site.
  1215. # 211 System status, or system help reply.
  1216. # 212 Directory status.
  1217. # 213 File status.
  1218. # 214 Help message.
  1219. #     On how to use the server or the meaning of a particular
  1220. #     non-standard command.  This reply is useful only to the
  1221. #     human user.
  1222. # 215 NAME system type.
  1223. #     Where NAME is an official system name from the list in the
  1224. #     Assigned Numbers document.
  1225. # 220 Service ready for new user.
  1226. # 221 Service closing control connection.
  1227. #     Logged out if appropriate.
  1228. # 225 Data connection open; no transfer in progress.
  1229. # 226 Closing data connection.
  1230. #     Requested file action successful (for example, file
  1231. #     transfer or file abort).
  1232. # 227 Entering Passive Mode (h1,h2,h3,h4,p1,p2).
  1233. # 230 User logged in, proceed.
  1234. # 250 Requested file action okay, completed.
  1235. # 257 "PATHNAME" created.
  1236.  
  1237. # 331 User name okay, need password.
  1238. # 332 Need account for login.
  1239. # 350 Requested file action pending further information.
  1240.  
  1241. # 421 Service not available, closing control connection.
  1242. #     This may be a reply to any command if the service knows it
  1243. #     must shut down.
  1244. # 425 Can't open data connection.
  1245. # 426 Connection closed; transfer aborted.
  1246. # 450 Requested file action not taken.
  1247. #     File unavailable (e.g., file busy).
  1248. # 451 Requested action aborted: local error in processing.
  1249. # 452 Requested action not taken.
  1250. #     Insufficient storage space in system.
  1251.  
  1252. # 500 Syntax error, command unrecognized.
  1253. #     This may include errors such as command line too long.
  1254. # 501 Syntax error in parameters or arguments.
  1255. # 502 Command not implemented.
  1256. # 503 Bad sequence of commands.
  1257. # 504 Command not implemented for that parameter.
  1258. # 530 Not logged in.
  1259. # 532 Need account for storing files.
  1260. # 550 Requested action not taken.
  1261. #     File unavailable (e.g., file not found, no access).
  1262. # 551 Requested action aborted: page type unknown.
  1263. # 552 Requested file action aborted.
  1264. #     Exceeded storage allocation (for current directory or
  1265. #     dataset).
  1266. # 553 Requested action not taken.
  1267. #     File name not allowed.
  1268.  
  1269.  
  1270. # make this package return true
  1271. 1;
  1272.